LINEA SUMARIO DE INFORMACION

Column

Subset Data: Tabla

Sumario Variables Cuantiativas

ANALISIS LINEA BASE GEOAMBIENTAL

Column

Column

Al_dis

Al_tot

Al_BP

Cu_dis

Hg_dis

Pb_dis

Al_tot

Sb_tot

As_tot

Cd_tot

Cu_tot

Fe_tot

Mn_tot

Hg_tot

Pb_tot

Tabla

El promedio de los datos de As es:

La cantidad de datos selecccionados es:

La tabla filtrada de datos selecccionados:

Filtro Interactivo

---
title: "Linea Base Geoambiental"
output:
  flexdashboard::flex_dashboard:
    orientation: columns
    theme: lumen
    source_code: embed
  html_document:
    df_print: paged
---

```{r setup, include=FALSE}
library(flexdashboard) ; library(crosstalk) ; library(tidyverse) ; library(plotly); library(sf); library(mapview); library(DT); library(readxl); library(tmap); library(linemap); library(rgdal);library(leaflet.extras); library(summarywidget); library(crosstable);
library(psych); library(data.table); library(leaflet.providers); library(leafem)

#remotes::install_github("kent37/summarywidget")

Tumbes <- read_xlsx(path = "BD.xlsx", col_names = TRUE)
colnames(Tumbes)
Tumbes <- Tumbes %>% select("Código Corto", "Nombre completo", "Norte", "Este",
                            "Cota", "Lugar", "Distrito", "Provincia","Cuenca",
                            "Clase de fuente","Aspecto Geológico",
                            "Color", "Olor", "pH", "CE_uS/cm", "TDS_mg/L", "Salinidad_PSU","Precipitados",
                            "Presencia de basurales", "Pasivos Ambientales", "Población",
                            "Aluminio Disuelto (Al)", "Aluminio (Al)",
                            "Arsénico Disuelto (As)","Arsénico (As)",
                            "Cobre Disuelto (Cu)", "Cobre (Cu)",
                            "Cadmio (Cd)",
                            "Mercurio Disuelto (Hg)", "Mercurio (Hg)",
                            "Hierro Disuelto (Fe)", "Hierro (Fe)",
                            "Manganeso Disuelto (Mn)", "Manganeso (Mn)",
                            "Magnesio Disuelto (Mg)", "Magnesio (Mg)",
                            "Plomo Disuelto (Pb)", "Plomo (Pb)",
                            "Antimonio Disuelto (Sb)","Antimonio (Sb)",
                            "Zinc Disuelto (Zn)", "Zinc (Zn)","Hidrotipo","Color")
Tumbes <- Tumbes %>% 
  rename(Codigo = "Código Corto", Nombre = "Nombre completo", Este = "Este",Norte = "Norte",
         Cota = "Cota", Lugar = "Lugar", Distrito ="Distrito", Provincia = "Provincia", Cuenca = "Cuenca", 
         Clase_Fuente = "Clase de fuente", Geologia = "Aspecto Geológico",
         Color = "Color", Olor = "Olor", ph = "pH", CE = "CE_uS/cm", TDS ="TDS_mg/L", Salinidad = "Salinidad_PSU",
         Precipitados = "Precipitados", Basurales = "Presencia de basurales", Pasivos = "Pasivos Ambientales",
         Poblacion = "Población", 
         Al_dis = "Aluminio Disuelto (Al)", Al_com = "Aluminio (Al)",
         As_dis = "Arsénico Disuelto (As)", As_com = "Arsénico (As)",
         Cu_dis = "Cobre Disuelto (Cu)", Cu_com = "Cobre (Cu)",
         Cd_com = "Cadmio (Cd)",
         Hg_dis = "Mercurio Disuelto (Hg)", Hg_com = "Mercurio (Hg)",
         Fe_dis = "Hierro Disuelto (Fe)", Fe_com = "Hierro (Fe)",
         Mn_dis = "Manganeso Disuelto (Mn)", Mn_com = "Manganeso (Mn)",
         Mg_dis = "Magnesio Disuelto (Mg)", Mg_com = "Magnesio (Mg)",
         Pb_dis = "Plomo Disuelto (Pb)", Pb_com = "Plomo (Pb)",
         Sb_dis = "Antimonio Disuelto (Sb)", Sb_com = "Antimonio (Sb)",
         Zn_dis = "Zinc Disuelto (Zn)", Zn_com = "Zinc (Zn)",
         Hidrotipo = "Hidrotipo", Color = "Color")

Tumbes$Zonal <- rep("Tumbes", nrow(Tumbes))
data01<-Tumbes[ ,c("Norte","Este")]
data01<-data01[ ,order(c(names(data01)))]
sputm <- SpatialPoints(data01, proj4string=CRS("+proj=utm +zone=17 +south +datum=WGS84")) 
spgeo <- spTransform(sputm, CRS("+proj=longlat +datum=WGS84"))
spgeo<-as.data.frame(spgeo)
colnames(spgeo)<-c("long","lat")
Tumbes<-cbind(Tumbes,spgeo)

Tumbes$colors <- factor(Tumbes$Hidrotipo, levels = unique(Tumbes$Hidrotipo))
cols <- c("#6666FF","#33CC33","#FF00FF","#FF6600")

colnames(Tumbes)
Tumbes <- Tumbes%>%mutate_if(is.character, as.factor)
str(Tumbes)
summary(Tumbes[ ,-c(9,12,44,45,46,47)])
sd <- SharedData$new(Tumbes)
Sys.setenv('MAPBOX_TOKEN' = 'pk.eyJ1IjoiYWxvbnNvMjUiLCJhIjoiY2tveGJseXJpMGNmcDJ3cDhicmZwYmY3MiJ9.SbThU_R8YGE1Zll-nNrZKA')

```

LINEA SUMARIO DE INFORMACION
=======================================================================

Column {.tabset}
-------------------------------------

### Subset Data: Tabla

```{r}
datatable(Tumbes)
```


### Sumario Variables Cuantiativas
```{r}

T2 <- Tumbes[ ,c(14,15,22:25)]

estadisticos <- function(col){
  
  norm_test <- shapiro.test(col)
  value <- c(round(length(col),3),round(sum(is.na(col))),round(min(col,na.rm=TRUE),3),round(quantile(col, 0.05,na.rm=TRUE),3),
               round(quantile(col, 0.25,na.rm=TRUE),3), round(mean(col,na.rm=TRUE),3), round(median(col,na.rm=TRUE),3),
               round(mean(col,trim = 0.10,na.rm=TRUE),3),
               round(quantile(col, 0.75,na.rm=TRUE),3), round(quantile(col, 0.95,na.rm=TRUE),3), round(IQR(col,na.rm=TRUE),3),
               round(mad(col,na.rm=TRUE),3),
               round(sd(col,na.rm=TRUE),3),round(skew(col,na.rm=TRUE),3), round(kurtosi(col,na.rm=TRUE),3), 
               round((sd(col,na.rm=TRUE)/mean(col,na.rm=TRUE))*100,3),
               norm_test$statistic, norm_test$p.value)

}
statistic <- c("N","Nulos","Minimo","P5 (5%)","Q1 (25%)","Media Aritmetica","Mediana",
                   "Trimmed mean (10%)","Q3 (75%)","P95 (95%)", "RIQ","MAD","Sd","As","K","CV",
                   "Shapiro statistic", "Shapiro p-valor")
T2PRO <- sapply(T2, estadisticos)
df <- data.table(statistic, T2PRO,keep.rownames=FALSE)
DT::datatable(df,
      # allows filtering on each column
    extensions = c(
      "Buttons",  # add download buttons, etc
      "Scroller"  # for scrolling down the rows rather than pagination
    ),
    rownames = FALSE,  # remove rownames
    style = "bootstrap",
    class = "compact",
    width = "100%",
    options = list(
      dom = "Blrtip",  # specify content (search box, etc)
      deferRender = TRUE,
      scrollY = 300,
      scroller = TRUE,
      columnDefs = list(
        list(
          visible = FALSE,
          targets = c(0,1)
        )
      ), 
      buttons = list(I("colvis"),'copy', 'csv', 'excel', 'pdf', 'print')
        
      )
    ) %>%
  formatStyle('statistic',  color = 'black', backgroundColor = 'lightgreen', fontWeight = 'bold')

```

ANALISIS LINEA BASE GEOAMBIENTAL
=======================================================================




```{r}
# filter_slider("h", "Altitud (metros)", sd, ~Cota)
# filter_select("Dpto", "Distrito", sd, ~Distrito)
# filter_select("Provincia", "Provincia", sd, ~Provincia)
# filter_select("Cuenca", "Cuenca", sd, ~Cuenca)
# filter_slider("ph", "Potencial de Hidrogeno", sd, ~ph)
# filter_slider("CE", "Conductividad Eléctrica", sd, ~CE)
```






Column {data-width=550}
-------------------------------------

###

```{r}
limite <- sf::st_read("shp_data/LIMITE_CUENCA.shp", quiet = TRUE)
drenaje <- sf::st_read("shp_data/Drenaje_Tumbes_Total.shp", quiet = TRUE)
fig <- plot_mapbox(drenaje)
plot_mapbox(sd, x = ~long, y = ~lat) %>%
  add_markers(
            split = ~Hidrotipo, color = ~colors, colors = cols , marker = list(size = 15),
            text = ~paste(paste("Codigo:", Codigo), paste("Nombre:", Nombre),
                          paste("Distrito:", Distrito), paste("Provincia:", Provincia),
                          paste("Lugar:", Lugar), paste("ph:", ph),
                          paste("CE (uS/cm):", CE), sep = "
"), mode = "scattermapbox", hoverinfo = "text") %>% layout(title = 'Analisis Geoambiental', font = list(color='white'), plot_bgcolor = '#191A1A', paper_bgcolor = '#191A1A', mapbox= list( style = "mapbox://styles/alonso25/ckppwz4o617pf17pn6iibpsku", sourcetype = 'vector', zoom = 9, showleyend = TRUE, center = list(lat = ~median(lat), lon = ~median(long)))) %>% highlight(on = "plotly_selected",off = "plotly_deselect", dynamic = FALSE, color = "red") ``` Column {.tabset} ------------------------------------- ### Al_dis ```{r} plot <- ggplot(sd, aes(x = ph, y = Al_dis, color = Clase_Fuente, text = paste("Codigo", Codigo, "
Codigo",Nombre, "
CE (uS/cm):",CE ))) + geom_point(size=5)+ geom_hline(yintercept = mean(Tumbes$Al_dis)+2*sd(Tumbes$Al_dis), colour = "red") ggplotly(plot) %>% highlight(on = "plotly_selected", off = "plotly_deselect", dynamic = FALSE , color = "red") ``` ### Al_tot ```{r} plot <- ggplot(sd, aes(x = ph, y = Al_com, color = Clase_Fuente, text = paste("Codigo", Codigo, "
Codigo",Nombre, "
CE (uS/cm):",CE ))) + geom_point(size=5)+ geom_hline(yintercept = 0.01, colour = "red")+ #ECA A2 geom_hline(yintercept = 0.10, colour = "green")+ #ECA D1 geom_hline(yintercept = 0.20, colour = "purple") #ECA D2 ggplotly(plot) %>% highlight(on = "plotly_selected", off = "plotly_deselect", dynamic = FALSE , color = "red") ``` ### Al_BP ```{r} plot2 <- ggplot(sd, aes(x = Zonal , y = As_dis)) + geom_boxplot() plot3 <- ggplot(sd, aes(x = Zonal , As_com)) + geom_boxplot() plot2 <- ggplotly(plot2) plot3 <- ggplotly(plot3) subplot(plot2, plot3, nrows = 1)%>% layout(yaxis = list(title = "Al_dis(mg/l) / Al_tot(mg/l)")) ``` ### Cu_dis ```{r} plot <- ggplot(sd, aes(x = ph, y = Cu_dis, color = Clase_Fuente, text = paste("Codigo", Codigo, "
Codigo",Nombre, "
CE (uS/cm):",CE ))) + geom_point(size=5)+ geom_hline(yintercept = mean(Tumbes$Cu_dis)+2*sd(Tumbes$Cu_dis), colour = "red") ggplotly(plot) %>% highlight(on = "plotly_selected", off = "plotly_deselect", dynamic = FALSE , color = "red") ``` ### Hg_dis ```{r} plot <- ggplot(sd, aes(x = ph, y = Hg_dis, color = Clase_Fuente, text = paste("Codigo", Codigo, "
Codigo",Nombre, "
CE (uS/cm):",CE ))) + geom_point(size=5)+ geom_hline(yintercept = mean(Tumbes$Hg_dis)+2*sd(Tumbes$Hg_dis), colour = "red") ggplotly(plot) %>% highlight(on = "plotly_selected", off = "plotly_deselect", dynamic = FALSE , color = "red") ``` ### Pb_dis ```{r} plot <- ggplot(sd, aes(x = ph, y = Pb_dis, color = Clase_Fuente, text = paste("Codigo", Codigo, "
Codigo",Nombre, "
CE (uS/cm):",CE ))) + geom_point(size=5)+ geom_hline(yintercept = mean(Tumbes$Pb_dis)+2*sd(Tumbes$Pb_dis), colour = "red") ggplotly(plot) %>% highlight(on = "plotly_selected", off = "plotly_deselect", dynamic = FALSE , color = "red") ``` ### Al_tot ```{r} plot <- ggplot(sd, aes(x = ph, y = Al_com, color = Clase_Fuente, text = paste("Codigo", Codigo, "
Codigo",Nombre, "
CE (uS/cm):",CE ))) + geom_point(size=5)+ geom_hline(yintercept = 5, colour = "red")+ #ECA A2 geom_hline(yintercept = 5, colour = "green")+ #ECA D1 geom_hline(yintercept = 5, colour = "purple") #ECA D2 ggplotly(plot) %>% highlight(on = "plotly_selected", off = "plotly_deselect", dynamic = FALSE , color = "red") ``` ### Sb_tot ```{r} plot <- ggplot(sd, aes(x = ph, y = Sb_com, color = Clase_Fuente, text = paste("Codigo", Codigo, "
Codigo",Nombre, "
CE (uS/cm):",CE ))) + geom_point(size=5)+ geom_hline(yintercept = 0.02, colour = "red") #ECA A2 ggplotly(plot) %>% highlight(on = "plotly_selected", off = "plotly_deselect", dynamic = FALSE , color = "red") ``` ### As_tot ```{r} plot <- ggplot(sd, aes(x = ph, y = As_com, color = Clase_Fuente, text = paste("Codigo", Codigo, "
Codigo",Nombre, "
CE (uS/cm):",CE ))) + geom_point(size=5)+ geom_hline(yintercept = 0.01, colour = "red")+ #ECA A2 geom_hline(yintercept = 0.10, colour = "green")+ #ECA D1 geom_hline(yintercept = 0.20, colour = "purple") #ECA D2 ggplotly(plot) %>% highlight(on = "plotly_selected", off = "plotly_deselect", dynamic = FALSE , color = "red") ``` ### Cd_tot ```{r} plot <- ggplot(sd, aes(x = ph, y = Cd_com, color = Clase_Fuente, text = paste("Codigo", Codigo, "
Codigo",Nombre, "
CE (uS/cm):",CE ))) + geom_point(size=5)+ geom_hline(yintercept = 0.005, colour = "red")+ #ECA A2 geom_hline(yintercept = 0.010, colour = "green")+ #ECA D1 geom_hline(yintercept = 0.050, colour = "purple") #ECA D2 ggplotly(plot) %>% highlight(on = "plotly_selected", off = "plotly_deselect", dynamic = FALSE , color = "red") ``` ### Cu_tot ```{r} plot <- ggplot(sd, aes(x = ph, y = Cu_com, color = Clase_Fuente, text = paste("Codigo", Codigo, "
Codigo",Nombre, "
CE (uS/cm):",CE ))) + geom_point(size=5)+ geom_hline(yintercept = 2.00, colour = "red")+ #ECA A2 geom_hline(yintercept = 0.20, colour = "green")+ #ECA D1 geom_hline(yintercept = 0.50, colour = "purple") #ECA D2 ggplotly(plot) %>% highlight(on = "plotly_selected", off = "plotly_deselect", dynamic = FALSE , color = "red") ``` ### Fe_tot ```{r} plot <- ggplot(sd, aes(x = ph, y = Fe_com, color = Clase_Fuente, text = paste("Codigo", Codigo, "
Codigo",Nombre, "
CE (uS/cm):",CE ))) + geom_point(size=5)+ geom_hline(yintercept = 1.00, colour = "red")+ #ECA A2 geom_hline(yintercept = 5.00, colour = "green") ggplotly(plot) %>% highlight(on = "plotly_selected", off = "plotly_deselect", dynamic = FALSE , color = "red") ``` ### Mn_tot ```{r} plot <- ggplot(sd, aes(x = ph, y = Mn_com, color = Clase_Fuente, text = paste("Codigo", Codigo, "
Codigo",Nombre, "
CE (uS/cm):",CE ))) + geom_point(size=5)+ geom_hline(yintercept = 0.04, colour = "red")+ #ECA A2 geom_hline(yintercept = 0.02, colour = "green")+ #ECA D1 geom_hline(yintercept = 0.02, colour = "purple") #ECA D2 ggplotly(plot) %>% highlight(on = "plotly_selected", off = "plotly_deselect", dynamic = FALSE , color = "red") ``` ### Hg_tot ```{r} plot <- ggplot(sd, aes(x = ph, y = Hg_com, color = Clase_Fuente, text = paste("Codigo", Codigo, "
Codigo",Nombre, "
CE (uS/cm):",CE ))) + geom_point(size=5)+ geom_hline(yintercept = 0.002, colour = "red")+ #ECA A2 geom_hline(yintercept = 0.001, colour = "green")+ #ECA D1 geom_hline(yintercept = 0.010, colour = "purple") #ECA D2 ggplotly(plot) %>% highlight(on = "plotly_selected", off = "plotly_deselect", dynamic = FALSE , color = "red") ``` ### Pb_tot ```{r} plot <- ggplot(sd, aes(x = ph, y = Pb_com, color = Clase_Fuente, text = paste("Codigo", Codigo, "
Codigo",Nombre, "
CE (uS/cm):",CE ))) + geom_point(size=5)+ geom_hline(yintercept = 0.05, colour = "red")+ #ECA A2 geom_hline(yintercept = 0.05, colour = "green")+ #ECA D1 geom_hline(yintercept = 0.05, colour = "purple") #ECA D2 ggplotly(plot) %>% highlight(on = "plotly_selected", off = "plotly_deselect", dynamic = FALSE , color = "red") ``` ### Tabla El **promedio** de los datos de As es: ```{r} summarywidget(sd, statistic = "mean", column = "As_dis", digits = 3) ``` La **cantidad** de datos selecccionados es: ```{r} summarywidget(sd, statistic = "count", column = "As_dis", digits = 0) ``` La tabla **filtrada** de datos selecccionados: ```{r} sd %>% DT::datatable( filter = "top", # allows filtering on each column extensions = c( "Buttons", # add download buttons, etc "Scroller" # for scrolling down the rows rather than pagination ), rownames = FALSE, # remove rownames style = "bootstrap", class = "compact", width = "100%", options = list( dom = "Blrtip", # specify content (search box, etc) deferRender = TRUE, scrollY = 300, scroller = TRUE, columnDefs = list( list( visible = FALSE, targets = c(2, 3, 6:33) ) ), buttons = list( I("colvis"), # turn columns on and off "csv", # download as .csv "excel" # download as .xlsx ) ) ) ``` Filtro Interactivo